# /packages/blogspace/rss-procs.tcl
ad_library {
	Utilities useful in building RSS files.

	@author Aaron Swartz <aaron@blogspace.com>
	@creation-date 2001-2-14
	@cvs-id $Id$
}

ad_proc as_write_rss {
	-noquote:boolean
	rssLink
	channelTitle
	channelDescription
	channelLink
	items
} {
	# array of URIs so that we don't have duplicate rdf:about's
	set uris("") 0
	# unique number, for genids
	set genid 0
	# use a dummy proc if we're not quoting
	if {$noquote_p} {
	    set quote_proc as_do_nothing
	} {
	    set quote_proc ad_quotehtml
	}

	append out {<?xml version="1.0" encoding="UTF-8"?>
	<rdf:RDF 
	  xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" 
	  xmlns:dc="http://purl.org/dc/elements/1.1/"
	  xmlns:sy="http://purl.org/rss/1.0/modules/syndication/"
	  xmlns="http://purl.org/rss/1.0/"
	>
	}

	set uris($rssLink) "1"
	append out "<channel rdf:about=\"$rssLink\">
	<title>[$quote_proc $channelTitle]</title>
	<link>[$quote_proc $channelLink]</link>"

	if {![empty_string_p $channelDescription]} { append out "
		<description>[$quote_proc $channelDescription]</description>"}
		append out "
		<sy:updatePeriod>hourly</sy:updatePeriod>
		<items>
		  <rdf:Seq>"
	
		set items2 ""
		foreach item_l $items {
		    if {[info exists item]} { unset item}
		    array set item $item_l
		    if {![info exists item(uri)]} {
				if {[info exists uris($item(link))]} {
				    incr genid
				    set item(uri) $item(link)#genid$genid
				} {
			    set item(uri) $item(link)
			    set uris($item(uri)) 1
				}
		    }
		    append out "
		    <rdf:li rdf:resource=\"[$quote_proc $item(uri)]\" />"
		    lappend items2 [array get item]
		}
	
		append out "
			  </rdf:Seq>
			</items>
		</channel>"
		
		foreach item_l $items2 {
			array set item $item_l
			append out "
		<item rdf:about=\"[$quote_proc $item(uri)]\">
			<title>[$quote_proc $item(title)]</title>
			<link>[$quote_proc $item(link)]</link>"
			if {![string is space $item(description)]} {
				append out "
			<description>[$quote_proc $item(description)]</description>"
			}
			foreach {tag content} $item_l {
			    if {[string range $tag 0 2] == "dc:"} {
				append out "
			    <$tag>$content</$tag>"
			    }
			}
			append out "
		    </item>"
		}
	append out "
	</rdf:RDF>
	"
	return $out
}

ad_proc as_swipe2rss {
    -last:boolean
    -nomunge:boolean
	-page
	-exp
	url
	channelTitle  
	channelDescription 
	listStart 
	listEnd 
	{itemStart ""}
	{itemEnd ""}
} {
	Takes SWIPE properties and returns an RSS 1.0 file.
} {
if ![nsv_exists rss_swipe swipe_lock] {
    nsv_set rss_swipe swipe_lock [ns_mutex create]
}
ns_mutex lock [nsv_get rss_swipe swipe_lock]
catch {
set items "" ;# list of RSS items
if {![info exists page]} {
	set page [util_httpget http://check.theinfo.org/html/tidy?char=1&justcontent=1&url=[ns_urlencode $url]]
    if {[empty_string_p $page]} {
		set page [util_httpget $url]
    }
}

if {![empty_string_p $listStart] && ![empty_string_p $listEnd]} {
	set page [as_get_contents $page $listStart $listEnd] ;# strip out excess
}

if {$last_p} {
    # Take the last link
    set first_reg ".*"
} {
    set first_reg ""
}

set attribRE "$first_reg<a(.*?)>(.*?)</a>"

set page2 ""
set iter 0
while 1 {
    incr iter
	if {[string equal $page2 $page] || $iter >= 1000} {
		ns_log Error "programming error: infinite loop in as_swipe2rss $page $match"
		break
	}
	if {[info exists exp]} { # Someone gave us some code to execute
	    if {[catch { eval $exp }] != 0} { 
		break ;# Stop if it didn't work.
	    }
	} {	
		if {[catch {set contents [as_get_contents $page $itemStart $itemEnd]}]} {
			break ;# break if there's no match
		}
		set match $itemStart$contents$itemEnd
	}
	## Process content:
	if {[info exists attrib]} {unset attrib ;# an array for attributes}
	if {[regexp -nocase $attribRE $contents titlematch attributes title]} {
		ad_parse_html_attributes -quote -attribute_array attrib $attributes
		if {[info exists attrib(title)]} {
			set title $attrib(title)
		} {
			set title [as_cleanhtml $title]
		}
		set link [as_resolve_relative_uri $url $attrib(href)]
		
		# remove the title from the description if it's the first thing
		# otherwise there's like to be surrounding content that'll look out-of-place

		if {[string match "[string trim [as_cleanhtml $title]]*" [string trim [as_cleanhtml $contents]]]} {
			set contents [as_string_replace $contents $titlematch]
		}

	} {
		set title "Untitled"
		set link $url
	}

	if {$nomunge_p} {
	    set description [ns_quotehtml [ns_striphtml $contents]]
	} {
	    set description [ns_quotehtml [ad_html_to_text -nolinks -- $contents]]
	}

	lappend items [list title $title link $link description $description]

	# remove it from page so we can search again:
	set page2 $page
	set page [as_string_replace $page $match]
}
}
ns_mutex unlock [nsv_get rss_swipe swipe_lock]
return [as_write_rss $url $channelTitle $channelDescription $url $items]
}